home *** CD-ROM | disk | FTP | other *** search
/ Ahoy 1985 June / Ahoy_Magazine_85-06_1985_Double_L.d64 / broken melody (.txt) < prev    next >
Commodore BASIC  |  2022-10-26  |  7KB  |  257 lines

  1. 0 print"[147]":poke53280,0:poke53281,6
  2. 1 print "broken melody....":print
  3. 2 print "three voices wait for user input between phrases":print
  4. 3 print "use this routine for a series of rewards"
  5. 4 rem
  6. 5 print "plays i'm on my way (from paint your     wagon by lerner & loewe)"
  7. 6 print:print" one moment please..."
  8. 10 gosub 9000:goto 100
  9. 60 for n=1 to len(md$(ph))
  10. 61 for vc=0 to ev%
  11. 62 poke gr(vc),ug%(vc):rem normal notes; don't poke ug% for legato
  12. 63 for i=0 to 1
  13. 64 poke fr(vc,i),pi%(asc(mid$(me$(ph,vc),n,1)),i)
  14. 65 next:next
  15. 66 for vc=ev% to 0 step -1:poke gr(vc),g%(vc):next
  16. 67 for i=0 to du%(val(mid$(md$(ph),n,1))):next
  17. 68 rem for vc=0 to ev%:poke gr(vc),ug%(vc):next:rem staccato notes
  18. 69 next:ph=ph+1:if ph>es% then ph=0
  19. 70 for vc=0 to ev%:poke gr(vc),ug%(vc):next:return
  20. 100 print "press shift for phrase "ph
  21. 110 print "any other key to stop"
  22. 120 if peek(203)<>64 then end
  23. 130 if peek(653)=0 then 120
  24. 140 gosub 60
  25. 190 goto 100
  26. 8997 rem
  27. 8998 rem set up sound shape
  28. 8999 rem
  29. 9000 dim md$(23),me$(23,2),mv$(23,2),g%(2),gr(2),fr(2,1),ad(2)
  30. 9001 dim du%(9),pi%(168,1),ak%(2),dy%(2),sn%(2),re%(2),wf%(2)
  31. 9007 rem
  32. 9008 rem attack--voices 0,1,2
  33. 9009 rem number from 0 to 15; lower number=sharper attack
  34. 9010 ak%(0)=0:ak%(1)=0:ak%(2)=0
  35. 9015 for i=0 to 2:ak%(i)=ak%(i)*16:next
  36. 9017 rem
  37. 9018 rem decay--voices 0,1,2
  38. 9019 rem number from 0 to 15; lower number=faster decline
  39. 9020 dy%(0)=7:dy%(1)=3:dy%(2)=3
  40. 9027 rem
  41. 9028 rem sustain--voices 0,1,2
  42. 9029 rem number from 0 to 15; lower number=softer volume during sustain
  43. 9030 sn%(0)=0:sn%(1)=0:sn%(2)=0
  44. 9035 for i=0 to 2:sn%(i)=sn%(i)*16:next
  45. 9037 rem
  46. 9038 rem release--voices 0,1,2
  47. 9039 rem number from 0 to 15; lower number=faster drop to silence at end
  48. 9040 re%(0)=0:re%(1)=3:re%(2)=5
  49. 9047 rem
  50. 9048 rem set sound addresses
  51. 9049 rem
  52. 9050 fr(0,0)=54272:fr(1,0)=54279:fr(2,0)=54286
  53. 9055 for i=0 to 2:fr(i,1)=1+fr(i,0):gr(i)=fr(i,0)+4:ad(i)=gr(i)+1:next
  54. 9057 rem
  55. 9058 rem poke adsr envelopes
  56. 9059 rem
  57. 9060 for i=0 to 2:poke ad(i),at%(i) or dy%(i)
  58. 9065 poke ad(i)+1,sn%(i) or re%(i):next
  59. 9066 rem
  60. 9067 rem set up gates
  61. 9068 rem waveforms, voices 0,1,2 (add values):
  62. 9069 rem triangle on=16; sawtooth on=32; pulse on=64 (set width!); noise on=128
  63. 9070 wf%(0)=32:wf%(1)=64:wf%(2)=64
  64. 9075 for i=0 to 2:g%(i)=1 or wf%(i):ug%(i)=g%(i)and 254:next
  65. 9077 rem
  66. 9078 rem set pulse widths
  67. 9079 rem voices 0,1,2; low byte, high byte
  68. 9080 poke gr(0)-2,200:poke gr(0)-1,3
  69. 9081 poke gr(1)-2,200:poke gr(1)-1,3
  70. 9082 poke gr(2)-2,200:poke gr(2)-1,3
  71. 9096 rem
  72. 9097 rem set up pitch array
  73. 9098 rem each note, in all its octaves
  74. 9099 rem c
  75. 9100 x%=3:gosub 9190
  76. 9101 data 12,1,24,2,48,4,97,8,195,16,135,33,15,67,30,134
  77. 9102 rem d
  78. 9103 x%=4:gosub 9190
  79. 9104 data 45,1,90,2,180,4,104,9,209,18,162,37,69,75,139,150
  80. 9105 rem e (f-flat)
  81. 9106 x%=5:gosub 9190:y%=13:gosub 9195
  82. 9107 data 81,1,163,2,71,5,143,10,31,21,62,42,125,84,250,168
  83. 9108 rem f (e-sharp)
  84. 9109 x%=6:gosub 9190:y%=19:gosub 9195
  85. 9110 data 102,1,204,2,152,5,48,11,96,22,193,44,131,89,6,179
  86. 9111 rem g
  87. 9112 x%=7:gosub 9190
  88. 9113 data 145,1,35,3,71,6,143,12,30,25,60,50,121,100,243,200
  89. 9114 rem a
  90. 9115 x%=1:gosub 9190
  91. 9116 data 195,1,134,3,12,7,24,14,49,28,99,56,199,112,143,225
  92. 9117 rem b
  93. 9118 x%=2:gosub 9190
  94. 9119 data 250,1,244,3,233,7,210,15,165,31,75,63,151,126,46,253
  95. 9120 rem d-flat (c-sharp)
  96. 9121 x%=11:gosub 9190:y%=17:gosub 9195
  97. 9122 data 28,1,56,2,112,4,225,8,195,17,134,35,12,71,24,142
  98. 9123 rem e-flat (d-sharp)
  99. 9124 x%=12:gosub 9190:y%=18:gosub 9195
  100. 9125 data 62,1,125,2,251,4,247,9,239,19,223,39,191,79,126,159
  101. 9126 rem g-flat (f-sharp)
  102. 9127 x%=14:gosub 9190:y%=20:gosub 9195
  103. 9128 data 123,1,246,2,237,5,218,11,181,23,107,47,214,94,172,189
  104. 9129 rem a-flat (g-sharp)
  105. 9130 x%=8:gosub 9190:y%=21:gosub 9195
  106. 9131 data 169,1,83,3,167,6,78,13,156,26,57,53,115,106,230,212
  107. 9132 rem b-flat (a-sharp)
  108. 9133 x%=9:gosub 9190:y%=15:gosub 9195
  109. 9134 data 221,1,187,3,119,7,239,14,223,29,190,59,124,119,248,238
  110. 9135 rem c-flat
  111. 9136 x%=10:gosub 9190
  112. 9137 data 4,1,250,1,244,3,233,7,210,15,165,31,75,63,151,126
  113. 9138 rem b-sharp
  114. 9139 x%=16:gosub 9190
  115. 9140 data 24,2,48,4,97,8,195,16,135,33,15,67,30,134,255,255
  116. 9185 goto 9200
  117. 9189 rem read pitches
  118. 9190 for i=0 to 147 step 21:read pi%(i+x%,0),pi%(i+x%,1):next:return
  119. 9194 rem identical pitches
  120. 9195 for i=0 to 147 step 21:pi%(i+y%,0)=pi%(i+x%,0):pi%(i+y%,1)=pi%(i+x%,1)
  121. 9196 next:return
  122. 9197 rem
  123. 9198 rem set up durations
  124. 9199 rem
  125. 9200 for i=0 to 9:read du%(i):next
  126. 9205 data 10,128,256,384,512,640,768,1024,1152,1280
  127. 9296 rem
  128. 9297 rem set filter and volume
  129. 9298 rem filter frequency
  130. 9299 rem low byte (0-7) x%; high byte (0-255) y%
  131. 9300 x%=0:y%=100
  132. 9305 poke 54293,x%:poke 54294,y%
  133. 9308 rem filter on?
  134. 9309 rem voice 1 on=1; 2 on=2; 3 on=4; 1&2 on=3; 2&3 on=6; all on=7
  135. 9310 x%=0
  136. 9318 rem filter resonance
  137. 9319 rem peak volume (0=low, 15=high)
  138. 9320 y%=14
  139. 9325 y%=y%*16:poke 54295,x% or y%
  140. 9328 rem select filter type
  141. 9329 rem low-pass=1;band-pass=2;high-pass=4;lo-band=3;hi-band=6;all=7
  142. 9330 x%=1
  143. 9335 x%=x%*16
  144. 9337 rem
  145. 9338 rem select overall volume
  146. 9339 rem 15=high, 0=low
  147. 9340 y%=15
  148. 9345 poke 54296,x% or y%
  149. 9496 rem
  150. 9497 rem set melodies here
  151. 9498 rem
  152. 9499 rem how many voices? (minus one)
  153. 9500 ev%=2
  154. 9508 rem
  155. 9509 rem how many phrases? (minus one)
  156. 9510 es%=8
  157. 9514 rem
  158. 9515 rem melody strings
  159. 9516 rem
  160. 9517 rem each phrase has only one du%(ph) string, no matter how many voices
  161. 9518 rem each phrase has one me$(ph,vc) & one mv$(ph,vc) string per voice
  162. 9519 rem phrase 0
  163. 9520 md$(0)="0000000000000000"
  164. 9521 me$(0,0)="fffgafg@fffgafge"
  165. 9522 mv$(0,0)="6               "
  166. 9523 me$(0,1)="ccdcgdccccdcgdcc"
  167. 9524 mv$(0,1)="4545354545453545"
  168. 9525 me$(0,2)="faeagbc[191]fadagbc[191]"
  169. 9526 mv$(0,2)="3434343434343434"
  170. 9529 rem phrase 1
  171. 9530 md$(1)="0000000000000000"
  172. 9531 me$(1,0)="fffgafgef@@@@@@@"
  173. 9532 mv$(1,0)="6               "
  174. 9533 me$(1,1)="fcecdbccfcecdaca"
  175. 9534 mv$(1,1)="45454  545454  5"
  176. 9535 me$(1,2)="faeadbc[191]faeadfcf"
  177. 9536 mv$(1,2)="3434343434343435"
  178. 9539 rem phrase 2
  179. 9540 md$(2)="0000000000000000"
  180. 9541 me$(2,0)="[191][191][191]cd[191]c@[191][191][191]cd[191]ca"
  181. 9542 mv$(2,0)="6  7 67 6  7 676"
  182. 9543 me$(2,1)="@f@fcgff@f@fcgff"
  183. 9544 mv$(2,1)=" 5  4545    4545"
  184. 9545 me$(2,2)="[191]dgdcef[177][191]dgdcef[177]"
  185. 9546 mv$(2,2)="3535353535353535"
  186. 9549 rem phrase 3
  187. 9550 md$(3)="00000000000000"
  188. 9551 me$(3,0)="[191][191][191]cd[191]ca[191]@@@@@"
  189. 9552 mv$(3,0)="6  7 676      "
  190. 9553 me$(3,1)="[191]fafgeff[191]fafgf"
  191. 9554 mv$(3,1)="45454545454545"
  192. 9555 me$(3,2)="[191]dadgcf[177][191]dadgd"
  193. 9556 mv$(3,2)="35353535353535"
  194. 9559 rem phrase 4
  195. 9560 md$(4)="0000000000000000"
  196. 9561 me$(4,0)="f[191]c@c@@@d[191]c@@@@@"
  197. 9562 mv$(4,0)="6 7      67     "
  198. 9563 me$(4,1)="fffag[191]aadgfag[191]aa"
  199. 9564 mv$(4,1)="45454545 4 54545"
  200. 9565 me$(4,2)="fdffgeaf[191]fffgeaf"
  201. 9566 mv$(4,2)="3535353534353535"
  202. 9569 rem phrase 5
  203. 9570 md$(5)="000000000000000000"
  204. 9571 me$(5,0)="cfg@g@@gafg@@@@@@@"
  205. 9572 mv$(5,0)="6                 "
  206. 9573 me$(5,1)="@bgegfge@bfeccafgc"
  207. 9574 mv$(5,1)=" 4 54545 4 5453   "
  208. 9575 me$(5,2)="@aecdbecgacfc[191]afgf"
  209. 9576 mv$(5,2)=" 4 54  534343 2  1"
  210. 9579 rem phrase 6
  211. 9580 md$(6)="0000000000000000"
  212. 9581 me$(6,0)="fffgafg@fffgafge"
  213. 9582 mv$(6,0)="6               "
  214. 9583 me$(6,1)="ccdcgdccccdcgdcc"
  215. 9584 mv$(6,1)="4545354545453545"
  216. 9585 me$(6,2)="faeagbc[191]fadagbc[191]"
  217. 9586 mv$(6,2)="3434343434343434"
  218. 9589 rem phrase 7
  219. 9590 md$(7)="000000000000000"
  220. 9591 me$(7,0)="fffgafgec@@@c@@"
  221. 9592 mv$(7,0)="6           7  "
  222. 9593 me$(7,1)="fcecdbcc@a@[191]cf@"
  223. 9594 mv$(7,1)="45454  5 4  5  "
  224. 9595 me$(7,2)="faeadbc[191]ffgra[177]@"
  225. 9596 mv$(7,2)="34343434343435 "
  226. 9599 rem phrase 8
  227. 9600 md$(8)="00000000000000000"
  228. 9601 me$(8,0)="dc@c[191]afgdf@@@f@@@"
  229. 9602 mv$(8,0)="7   6        7   "
  230. 9603 me$(8,1)="[191]caca@c@cfdc[191]a@f@"
  231. 9604 mv$(8,1)="5        46 5  4 "
  232. 9605 me$(8,2)="dcfcfcac[191]f[191]agf@f@"
  233. 9606 mv$(8,2)="545354 3435    3 "
  234. 9897 rem
  235. 9898 rem convert strings to usable form
  236. 9899 rem
  237. 9900 for ph=0 to es%:for vc=0 to ev%
  238. 9905 a$=me$(ph,vc):me$(ph,vc)=""
  239. 9910 for i=1 to len(a$)
  240. 9920 x%=asc(mid$(a$,i,1))
  241. 9930 if x%<72 then x%=x%-64:if x%<0 then x%=0
  242. 9931 if x%>192and x%<200 then x%=x%-178
  243. 9932 if x%=176 then x%=8
  244. 9933 if x%=191 then x%=9
  245. 9934 if x%=188 then x%=10
  246. 9935 if x%=172 then x%=11
  247. 9936 if x%=177 then x%=12
  248. 9937 if x%=187 then x%=13
  249. 9938 if x%=165 then x%=14
  250. 9939 if x%>21 then x%=0
  251. 9950 v$=mid$(mv$(ph,vc),i,1):if v$<>" " then y%=21*val(v$)
  252. 9960 if x%<>0 then x%=x%+y%
  253. 9970 me$(ph,vc)=me$(ph,vc)+chr$(x%)
  254. 9975 next:next:next
  255. 9980 ph=0
  256. 9990 return
  257.